home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / sys / hash.t < prev    next >
Text File  |  1988-02-05  |  4KB  |  82 lines
  1. (herald hash
  2.   (env tsys))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; Global hash table of weak pointers
  28.  
  29. ;;; Thanks to Gerry Sussman, Carl Hewitt, and Multics Maclisp
  30.  
  31. ;;; (object-hash obj)  =>  fixnum
  32. ;;;    Generates a unique numeric id for obj.
  33. ;;;
  34. ;;; (object-unhash fixnum)  =>  obj
  35. ;;;    Returns the object which has given id, if the object hasn't
  36. ;;;    been deleted by the GC.  Returns #F if object no longer exists.
  37. ;;;
  38. ;;; (eq? a b) if and only if (= (hash a) (hash b)).
  39. ;;;
  40. ;;; Numbers returned by "object-hash" really are unique - even if
  41. ;;; the object goes away, the number won't be recycled.  Ha.
  42.  
  43. ;;; New version using weak table from table package.  Not much left
  44. ;;; here.  Keeping only one table makes OBJECT-UNHASH a little slow.
  45. ;;; Shouldn't matter. -- But it does, I have seen OBJECT-UNHASH take
  46. ;;; 15+ seconds on a Apollo Tern.  The problem is probably paging time
  47. ;;; which should be reduced with the new table implementation.
  48.  
  49. ;;; These are not normal weak tables, the GC deals with them specially.
  50. ;;; OBJECT-HASH-TABLE must be weak in the values instead of the keys and
  51. ;;; neither will drop a pointer to a symbol.
  52.  
  53. ;++ These should be LOCAL
  54. (lset object-hash-table   (make-weak-table 'object-hash-table))
  55. (lset object-unhash-table (make-weak-table 'object-unhash-table))
  56. (lset generator -1)
  57.  
  58. ;;; Could keep separate hash tables for gc-copyable vs. static
  59. ;;; objects.  Stars and planets?
  60.  
  61. (define object-hash
  62.   (object (lambda (obj)
  63.             (cond ((weak-table-entry object-hash-table obj))
  64.                   (else
  65.                    (defer-interrupts
  66.                     (set generator (fx+ generator 1))
  67.                     (if (fx>= generator most-positive-fixnum)
  68.                         (error "cannot generate weak pointer - out of UID's"))
  69.                     (set (weak-table-entry object-hash-table obj) generator)
  70.                     (set (weak-table-entry object-unhash-table generator) obj)
  71.                     generator))))
  72.     ((re-initialize self)
  73.      (set object-hash-table (make-weak-table 'object-hash-table))
  74.      (set object-unhash-table (make-weak-table 'object-unhash-table))
  75.      (set generator 0))))
  76.  
  77. (define (object-unhash n)
  78.   (let ((n (enforce nonnegative-fixnum? n)))
  79.     (weak-table-entry object-unhash-table n)))
  80.  
  81. (define @ object-unhash)
  82.